home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PCMania 56
/
PCMania CD56_1.iso
/
abc.z
/
ORGCHART.FRM
< prev
next >
Wrap
Text File
|
1996-12-16
|
26KB
|
755 lines
VERSION 4.00
Begin VB.Form OrgChartDlg
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Organization Chart DEMO"
ClientHeight = 1815
ClientLeft = 465
ClientTop = 1755
ClientWidth = 5535
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 2220
Icon = "ORGCHART.frx":0000
Left = 405
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 1815
ScaleWidth = 5535
Top = 1410
Width = 5655
Begin VB.CommandButton OptionsBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Options..."
Height = 375
Left = 4080
TabIndex = 5
Top = 720
Width = 1335
End
Begin VB.CommandButton CancelBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Cancel"
Height = 375
Left = 2820
TabIndex = 4
Top = 1320
Width = 1335
End
Begin VB.CommandButton BrowseBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Browse..."
Height = 375
Left = 4080
TabIndex = 3
Top = 240
Width = 1335
End
Begin VB.CommandButton OKBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "OK"
Default = -1 'True
Enabled = 0 'False
Height = 375
Left = 1320
TabIndex = 2
Top = 1320
Width = 1335
End
Begin VB.TextBox OrgChartTextFileEdit
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 400
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 285
Left = 120
TabIndex = 1
Top = 600
Width = 3675
End
Begin MSComDlg.CommonDialog OrgChartBrowse
Left = 360
Top = 1320
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin AbcflowLib.ABC ABC1
Height = 375
Left = 4560
TabIndex = 6
Top = 1320
Width = 495
_version = 65536
_extentx = 873
_extenty = 661
_stockprops = 1
End
Begin VB.Line Line6
BorderColor = &H00808080&
X1 = 0
X2 = 5520
Y1 = 1800
Y2 = 1800
End
Begin VB.Line Line5
BorderColor = &H00808080&
X1 = 5520
X2 = 5520
Y1 = 1800
Y2 = 0
End
Begin VB.Line Line4
BorderColor = &H00FFFFFF&
X1 = 5520
X2 = 0
Y1 = 0
Y2 = 0
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
X1 = 0
X2 = 0
Y1 = 1800
Y2 = 0
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
X1 = 0
X2 = 5520
Y1 = 1210
Y2 = 1210
End
Begin VB.Line Line1
BorderColor = &H00808080&
X1 = 0
X2 = 5520
Y1 = 1200
Y2 = 1200
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "ASCII Text File:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 0
Top = 360
Width = 2055
End
End
Attribute VB_Name = "OrgChartDlg"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim ABC As Object
Dim FormatIter As Integer
Dim LoopIter As Integer
Dim TotalFormatIter As Integer
Dim req_objs As Integer
Private Sub ABC1_AppQuitNOTIFY()
End
End Sub
Private Sub BrowseBtn_Click()
OrgChartBrowse.Action = 1
' OrgChartBrowse.Filename = OrgChartTextFileEdit.Text
OrgChartTextFileEdit.Text = LCase(OrgChartBrowse.Filename)
OrgChartBrowse.Filename = "*.txt"
End Sub
Private Function CalcPercent() As Integer
CalcPercent = 100 * ((LoopIter / req_objs) / TotalFormatIter + (FormatIter - 1) / TotalFormatIter) + 1
If CalcPerent > 100 Then CalcPercent = 100
If CalcPerent < 0 Then CalcPercent = 0
LoopIter = LoopIter + 1
End Function
Private Sub CancelBtn_Click()
Unload OrgChartDlg
End Sub
Private Sub Command2_Click()
OrgChartBrowse.Action = 1
End Sub
Private Function DoCreateOrgChart(ByVal Filename As String) As Integer
Dim OrgItem As String
Dim Chart As Object
Dim cur_pos As Integer
Dim len_str As Integer
Rem Make a new chart
Set Chart = ABC.New
Rem Set the right shape palette
Chart.CurrentShapePalette = "Standard"
Chart.CurrentShape = "Process"
ABC.ShapePaletteVisible = False
Rem Set the Chart's internal type
Chart.Type = "PROCESS"
Rem Turn off master items
Chart.MasterItems.Hideall
Chart.DrawDirection = 2
Chart.DrawPositionX = 4
Chart.DrawPositionY = 1
Chart.DrawSpacingY = 0.25
Chart.CurrentLineRouting = 3
If OrgChartOptionsDlg.TopToBottomRBtn.Value = True Or OrgChartOptionsDlg.BottomToTopRBtn = True Then
vertical = True
Else
vertical = False
End If
If OrgChartOptionsDlg.BottomToTopRBtn.Value = True Or OrgChartOptionsDlg.RightToLeftRBtn = True Then
inverted = True
Else
inverted = False
End If
If vertical Then
Chart.PageLayout.Orientation = 1
Else
Chart.PageLayout.Orientation = 0
End If
Chart.NoRepaint = True
len_file = FileLen(Filename)
If len_file < 32767 And len_file > 0 Then
Dim EntireFile As String
Dim test_ascCode As Integer
Dim rank As Integer
Dim index As Integer
Dim cur_obj_count As Integer
Dim num_levels As Integer
Open Filename For Binary Access Read As #1
EntireFile = String$(len_file, " ")
Get #1, , EntireFile
Close
Rem Set up the progess bar
ABC.PercentGauge "Organization Chart DEMO", "PASS 1 of 2: Reading & parsing file..."
DrawnCount = 0
req_objs = GetNumLines(EntireFile) + 1
ReDim ShapeList(req_objs) As Object
ReDim ShapeRefStack(req_objs) As Integer
ReDim RelationMap(req_objs, 3) As Integer
Const first_child = 1, next_sibling = 2, parent = 3
cur_pos = 1
index = 2
cur_obj_count = 1
ShapeRefStack(1) = 1
Do While cur_pos < len_file + 1
test_ascCode = Asc(Mid$(EntireFile, cur_pos, 1))
rank = 2
While test_ascCode <> 13 And test_ascCode <> 10 And cur_pos < len_file + 1
If test_ascCode = 9 Then
rank = rank + 1
Else
OrgItem = OrgItem + Chr$(test_ascCode)
End If
cur_pos = cur_pos + 1
test_ascCode = Asc(Mid$(EntireFile, cur_pos, 1))
Wend
cur_pos = cur_pos + 1
OrgItem = FormatOrgString(OrgItem)
If rank > num_levels Then
num_levels = rank
End If
If Len(OrgItem) > 0 Then
If rank > index Then
index = index + 1
ElseIf rank < index Then
index = rank
End If
Chart.DrawPositionX = 1 + (index)
Chart.DrawPositionY = 2
cur_obj_count = cur_obj_count + 1
Set ShapeList(cur_obj_count) = Chart.DrawShape("Process")
ShapeList(cur_obj_count).Text = OrgItem
Rem update status bar
DrawnCount = DrawnCount + 1
ABC.PercentGaugeValue = 100 * DrawnCount / (req_objs - 1)
'Give all the shapes some attributes here
ShapeList(cur_obj_count).Shape.FillColor = ABC.YELLOW
ShapeList(cur_obj_count).Shape.BorderColor = ABC.BLUE
ShapeList(cur_obj_count).Shape.ShadowStyle = 1
ShapeList(cur_obj_count).Shape.NumberShown = False
ShapeList(cur_obj_count).Shape.BorderWidth = 3
ShapeList(cur_obj_count).Shape.FitShapeToText
ShapeRefStack(index) = cur_obj_count
RelationMap(cur_obj_count, parent) = ShapeRefStack(index - 1)
RelationMap(cur_obj_count, next_sibling) = RelationMap(RelationMap(cur_obj_count, parent), first_child)
RelationMap(RelationMap(cur_obj_count, parent), first_child) = cur_obj_count
RelationMap(cur_obj_count, first_child) = 0
OrgItem = ""
End If
If ABC.PercentGaugeCancelled Then Exit Do
Loop
If ABC.PercentGaugeCancelled Then GoTo DoCreateAbort
ABC.PercentGauge "Organization Chart DEMO", "PASS 2 of 2: Formatting chart..."
Rem There are currently five iterations of formatting
TotalFormatIter = 5
FormatIter = 0
'We need to go through the list and make sure
'the sizes work according to the Options Dlg
Const size_cx = 1, size_cy = 2
Dim finished As Integer
ReDim obj_size_level(req_objs, 2) As Double
Dim counter As Integer
finished = False
cur_obj_count = 1
index = 1
Call NewGaugeLoop
'Here we traverse the tree gathering the maximum size box in each level
While Not ABC.PercentGaugeCancelled And Not finished
Rem update status bar
ABC.PercentGaugeValue = CalcPercent()
If cur_obj_count <> 1 Then
If ShapeList(cur_obj_count).Height > obj_size_level(index, size_cy) Then
obj_size_level(index, size_cy) = ShapeList(cur_obj_count).Height
End If
If ShapeList(cur_obj_count).Width > obj_size_level(index, size_cx) Then
obj_size_level(index, size_cx) = ShapeList(cur_obj_count).Width
End If
End If
If RelationMap(cur_obj_count, first_child) = 0 Then
ShapeRefStack(index) = cur_obj_count
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
While cur_obj_count = 0 And index <> 1
index = index - 1
If index > 1 Then
cur_obj_count = ShapeRefStack(index)
If cur_obj_count Then
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
End If
End If
Wend
Else
ShapeRefStack(index) = cur_obj_count
index = index + 1
cur_obj_count = RelationMap(cur_obj_count, first_child)
End If
If index = 1 Then
finished = True
End If
Wend
'Now we have to adjust if the manager's size increases.
If OrgChartOptionsDlg.IncreaseMgrSize.Value = True Then
For counter = num_levels - 1 To 2 Step -1
If obj_size_level(counter, size_cx) < obj_size_level(counter + 1, size_cx) Then
obj_size_level(counter, size_cx) = obj_size_level(counter + 1, size_cx)
End If
If obj_size_level(counter, size_cy) < obj_size_level(counter + 1, size_cy) Then
obj_size_level(counter, size_cy) = obj_size_level(counter + 1, size_cy)
End If
Next
End If
'Reinitialize the loop vars
finished = False
cur_obj_count = 1
index = 1
Call NewGaugeLoop
'Here we traverse the tree gathering the maximum size box in each level
While Not ABC.PercentGaugeCancelled And Not finished
Rem update status bar
ABC.PercentGaugeValue = CalcPercent()
If cur_obj_count <> 1 Then
If OrgChartOptionsDlg.EqualWithinLevels.Value = True Then
ShapeList(cur_obj_count).Width = obj_size_level(index, size_cx)
ShapeList(cur_obj_count).Height = obj_size_level(index, size_cy)
Else 'The object has to be at least as big as the biggest on the next level
If OrgChartOptionsDlg.IncreaseMgrSize.Value = True Then
If index < num_levels And index > 1 Then
If ShapeList(cur_obj_count).Width < obj_size_level(index + 1, size_cx) Then
ShapeList(cur_obj_count).Width = obj_size_level(index + 1, size_cx)
End If
If ShapeList(cur_obj_count).Height < obj_size_level(index + 1, size_cy) Then
ShapeList(cur_obj_count).Height = obj_size_level(index + 1, size_cy)
End If
End If
End If
End If
End If
If RelationMap(cur_obj_count, first_child) = 0 Then
ShapeRefStack(index) = cur_obj_count
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
While cur_obj_count = 0 And index <> 1
index = index - 1
If index > 1 Then
cur_obj_count = ShapeRefStack(index)
If cur_obj_count Then
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
End If
End If
Wend
Else
ShapeRefStack(index) = cur_obj_count
index = index + 1
cur_obj_count = RelationMap(cur_obj_count, first_child)
End If
If index = 1 Then
finished = True
End If
Wend
'Format the chart *here*
'start at the top (the "God" object)
ReDim size_branch(req_objs) As Double
ReDim size_level(req_objs) As Double
Dim box_spacing_peers As Double
Dim box_spacing_levels As Double
' Dim vertical As Integer
' Dim inverted As Integer
box_spacing_peers = Val(OrgChartOptionsDlg.BoxSpacing.Text)
box_spacing_levels = box_spacing_peers * 2
finished = False
cur_obj_count = 1
index = 1
Call NewGaugeLoop
'We're just calculating the sizes that these shapes need so far.
While Not ABC.PercentGaugeCancelled And Not finished
Rem update status bar
ABC.PercentGaugeValue = CalcPercent()
If cur_obj_count <> 1 Then
If vertical = True Then
If ShapeList(cur_obj_count).Height > size_level(index) Then
size_level(index) = ShapeList(cur_obj_count).Height
End If
Else
If ShapeList(cur_obj_count).Width > size_level(index) Then
size_level(index) = ShapeList(cur_obj_count).Width
End If
End If
End If
If RelationMap(cur_obj_count, first_child) = 0 Then
ShapeRefStack(index) = cur_obj_count
For counter = 1 To index
If vertical = True Then
size_branch(ShapeRefStack(counter)) = size_branch(ShapeRefStack(counter)) + ShapeList(cur_obj_count).Width + box_spacing_peers
Else
size_branch(ShapeRefStack(counter)) = size_branch(ShapeRefStack(counter)) + ShapeList(cur_obj_count).Height + box_spacing_peers
End If
Next
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
While cur_obj_count = 0 And index <> 1
index = index - 1
If index > 1 Then
cur_obj_count = ShapeRefStack(index)
If cur_obj_count Then
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
End If
End If
Wend
Else
ShapeRefStack(index) = cur_obj_count
index = index + 1
cur_obj_count = RelationMap(cur_obj_count, first_child)
End If
If index = 1 Then
finished = True
End If
Wend
Dim posX As Double
Dim posY As Double
Dim newline As Object
'I'll have to admit - this is a little hard to follow - but it's BASIC you know, Visual or not
'Can't do too much about the recursion stuff in BASIC
posX = box_spacing_peers + size_branch(1)
posY = 0
mirrorX = box_spacing_peers + size_branch(1)
mirrorY = box_spacing_levels
cur_obj_count = 1
index = 1
finished = False
For counter = 2 To num_levels
mirrorY = mirrorY + size_level(counter) + box_spacing_levels
Next
Call NewGaugeLoop
'This is recursion in disguise....
'Don't be confused-> X and Y are reversed if this is not vertical
While Not ABC.PercentGaugeCancelled And Not finished
Rem update status bar
ABC.PercentGaugeValue = CalcPercent()
If cur_obj_count <> 1 Then
If vertical Then
ShapeList(cur_obj_count).CenterX = posX - (size_branch(cur_obj_count) / 2)
Else
ShapeList(cur_obj_count).CenterY = posX - (size_branch(cur_obj_count) / 2)
End If
posY = box_spacing_levels
For counter = 2 To index - 1
posY = posY + size_level(counter) + box_spacing_levels
Next
If vertical Then
If inverted Then
ShapeList(cur_obj_count).Bottom = mirrorY - posY
Else
ShapeList(cur_obj_count).Top = posY
End If
Else
If inverted Then
ShapeList(cur_obj_count).Right = mirrorY - posY
Else
ShapeList(cur_obj_count).Left = posY
End If
End If
End If
If RelationMap(cur_obj_count, first_child) = 0 Then
posX = posX - size_branch(cur_obj_count)
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
While cur_obj_count = 0 And index <> 1
index = index - 1
If index > 1 Then
cur_obj_count = ShapeRefStack(index)
If cur_obj_count Then
cur_obj_count = RelationMap(cur_obj_count, next_sibling)
End If
End If
Wend
Else
ShapeRefStack(index) = cur_obj_count
index = index + 1
cur_obj_count = RelationMap(cur_obj_count, first_child)
End If
If index = 1 Then
finished = True
End If
Wend
Call NewGaugeLoop
Junk = CalcPercent() ' since we're skipping an object in this loop
For counter = 2 To req_objs
If ABC.PercentGaugeCancelled Then Exit For
ABC.PercentGaugeValue = CalcPercent()
If RelationMap(counter, parent) > 1 Then
If vertical Then
If inverted Then
Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 0, 2)
Else
Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 2, 0)
End If
Else
If inverted Then
Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 3, 1)
Else
Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 1, 3)
End If
End If
newline.Line_.StemWidth = 3
newline.Line_.DestArrowStyle = 0
newline.Line_.SourceArrowStyle = 0
newline.Line_.Color = ABC.BLUE
End If
Next
DoCreateOrgChart = 1
Else
DoCreateOrgChart = 0
End If
DoCreateAbort:
Chart.View = 2
Chart.NoRepaint = False
Chart.Repaint
ABC.HidePercentGauge
End Function
Private Sub Form_Load()
Set ABC = CreateObject("ABCFlow.application")
ABC.Visible = True
OrgChartTextFileEdit = LCase(App.Path + "\ORGCHRT1.TXT")
Load OrgChartOptionsDlg
ABC.RegisterEvent ABC1, APPNAME, "AppQuitNOTIFY"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload OrgChartOptionsDlg
End Sub
Private Function FormatOrgString(ByVal OrgString As String) As String
Dim index As Integer
Dim len_str As Integer
Dim test_ascCode As Integer
Dim in_quotes As Integer
Dim FormattedStr As String
index = 1
in_quotes = False
len_str = Len(OrgString)
FormattedStr = ""
While index < (len_str + 1)
test_ascCode = Asc(Mid$(OrgString, index))
If test_ascCode = 34 Then
in_quotes = Not in_quotes
ElseIf in_quotes Then
FormattedStr = FormattedStr + Chr$(test_ascCode)
ElseIf test_ascCode = 44 Then: Rem comma
FormattedStr = FormattedStr + Chr$(13)
End If
index = index + 1
Wend
FormatOrgString = FormattedStr
End Function
Private Function GetNumLines(test_str As String) As Integer
Dim len_str As Integer
Dim index As Integer
Dim in_line_feed As Integer
Dim test_ascCode As Integer
Dim total_lines As Integer
in_line_feed = True
index = 1
len_str = Len(test_str)
total_lines = 0
While index < len_str + 1
test_ascCode = Asc(Mid$(test_str, index))
If test_ascCode = 13 Or test_ascCode = 10 Then
If Not in_line_feed Then
total_lines = total_lines + 1
in_line_feed = True
End If
Else
in_line_feed = False
End If
index = index + 1
Wend
GetNumLines = total_lines
End Function
Private Sub NewGaugeLoop()
LoopIter = 0
FormatIter = FormatIter + 1
End Sub
Private Sub OKBtn_Click()
OrgChartDlg.WindowState = 1 ' iconize form
OrgChartDlg.Refresh
success = DoCreateOrgChart(OrgChartTextFileEdit.Text)
End Sub
Private Sub OptionsBtn_Click()
OrgChartDlg.Enabled = False
OrgChartOptionsDlg.Show
End Sub
Private Sub OrgChartTextFileEdit_Change()
Call ValidateFilename
End Sub
Private Sub ValidateFilename()
On Error Resume Next
Attr = GetAttr(OrgChartTextFileEdit)
If Err Then
OKBtn.Enabled = False
Else
OKBtn.Enabled = True
End If
End Sub